﻿Option Strict On
Imports System.Text
Public Class RTFGenerator
    Dim Random As New Random
#Region "Variables"
    Private HighlightWords As New List(Of Word)
    Private _DefaultFontSize As Integer = 16
    Private _DefaultFontSizeTag As String = "\fs16 "
    Private rtffonttbl As String
    Private rtfcolortbl As String
    Private _IsLoaded As Boolean = False
#End Region
#Region "Properties"
    Public ReadOnly Property IsLoaded As Boolean
        Get
            Return _IsLoaded
        End Get
    End Property
    Public ReadOnly Property DefaultFontSizeTag As String
        Get
            Return _DefaultFontSizeTag
        End Get
    End Property
    Public Property DefaultFontSize As Integer
        Get
            Return _DefaultFontSize
        End Get
        Set(value As Integer)
            _DefaultFontSizeTag = "\fs" & value.ToString & " "
            _DefaultFontSize = value
        End Set
    End Property
#End Region
#Region "Constructers"
    Sub New()
        Dim TH As New Threading.Thread(AddressOf threadwork)
        TH.Start()
    End Sub
#End Region
#Region "Threads"
    Sub threadwork()
        Dim Keywords As List(Of String) = My.Resources.keywords.Split(CChar(vbCrLf)).ToList
        Dim Objects As List(Of String) = My.Resources.Objects.Split(CChar(vbCrLf)).ToList
        AddWordGroup(Objects, Color.Green)
        AddWordGroup(Keywords, Color.Red)
        SetWordTags()
        rtffonttbl = RTFFontTable(New List(Of String))
        rtfcolortbl = RTFColorTable()
        Me._IsLoaded = True
    End Sub
#End Region
#Region "Private Methods"
    Private Sub AddWordGroup(GroupWords As List(Of String), GroupColor As Color)
        For Each Word As String In GroupWords
            Word = Replace(Word, vbCr, "")
            Word = Replace(Word, vbLf, "")
            AddWord(Word, GroupColor)
        Next
    End Sub
    Private Sub AddWord(Word As String, Color As Color)
        Me.HighlightWords.Add(New Word(Color, Word))
    End Sub
    Function GetRandomObject() As String
        Randomize()
        Dim Objects As String() = (My.Resources.Objects.Split(CChar(vbCrLf)))
        Return Objects(Random.Next(0, Objects.Count))
    End Function
    Public Function GenerateSpeedTestClass(ByVal Approximatelines As Integer) As String
        Dim Source As New StringBuilder
        Source.Append("Public Class Lines" & Approximatelines.ToString & vbCrLf)
        Dim Counter As Integer = 1
        Do
            Source.Append(Space(4) & "Dim S" & Counter & " As " & GetRandomObject() & vbCrLf)
            Source.Append(Space(4) & "Public Sub Routine" & Counter & "()" & vbCrLf)
            Source.Append(Space(8) & "MsgBox(" & "S" & Counter & ")" & vbCrLf)
            Source.Append(Space(4) & "End Sub" & vbCrLf)
            Source.Append(Space(4) & "Public Function Funct" & Counter & "() As String" & vbCrLf)
            Source.Append(Space(8) & "Return " & "S" & Counter & ".ToString" & vbCrLf)
            Source.Append(Space(4) & "End Function" & vbCrLf)
            Counter += 1
        Loop Until (New RichTextBox With {.Text = Source.ToString}).Lines.Count >= Approximatelines
        Source.Append("End Class" & vbCrLf)
        Return Source.ToString
    End Function
    Private Function RTFColorTable() As String
        Dim Colors As New List(Of Color)
        For Each W As Word In HighlightWords
            If Colors.IndexOf(W.Color) = -1 Then Colors.Add(W.Color)
        Next
        Dim StartChunk As String = "{\colortbl ;"
        Dim EndChunk As String = "}"
        Dim SB As New StringBuilder
        SB.Append(StartChunk)
        For Each Clr As Color In Colors
            Dim C As String = "\red" & Clr.R.ToString & "\green" & Clr.G.ToString & "\blue" & Clr.B.ToString & ";"
            SB.Append(C)
        Next
        SB.Append(EndChunk)
        Return SB.ToString
    End Function
    Private Function RTFFontTable(AddFonts As List(Of String), Optional DefaultFontName As String = "Courier New") As String
        Dim SB As New StringBuilder
        AddFonts.Insert(0, DefaultFontName)
        SB.Append("{\fonttbl")
        For I = 0 To AddFonts.Count - 1
            SB.Append("{\f" & (I).ToString & "\fnil\fcharset0 " & AddFonts(I) & ";}")
        Next
        SB.Append("}")
        Return SB.ToString
    End Function
    Private Sub SetWordTags()
        Dim MyColorTags As New List(Of WordColorTag)
        Dim Counter As Integer = 1
        For Each w As Word In HighlightWords
            Dim TagFound As Boolean = False
            For Each CT As WordColorTag In MyColorTags
                If CT.Color = w.Color Then
                    w.ColorTag = CT.ColorTag
                    TagFound = True
                    Continue For
                End If
            Next
            If TagFound Then Continue For
            Dim AddTag As String = "\cf" & Counter.ToString
            Dim CTg As New WordColorTag(w.Color, AddTag)
            MyColorTags.Add(CTg)
            w.ColorTag = CTg.ColorTag
            Counter += 1
        Next
    End Sub
#End Region
#Region "Public Methods"
    Public Function TESTRTF(Testlines As Integer) As String
        Return GetHighlightRTF(GenerateSpeedTestClass(Testlines))
    End Function
    Public Function GetHighlightRTF(Source As String) As String
        Dim Text As String = Source
        Dim RTFs As New StringBuilder
        RTFs.Append("{\rtf1\ansi\ansicpg1252\deff0\deflang1033" _
                    & rtffonttbl & rtfcolortbl & "\viewkind4\uc1\pard\cf0\f0" _
                    & DefaultFontSizeTag)
        Text = Text.Replace(vbCrLf, "\par")
        For Each W As Word In Me.HighlightWords
            If Text.IndexOf(W.Word, 0) = -1 Then Continue For
            Text = Text.Replace(W.Word, W.WordRTF)
        Next
        RTFs.Append(Text & "}")
        Return RTFs.ToString
    End Function
#End Region
#Region "Classes"
    Private Class Word
        Public Property ColorTag As String
        Public Property FontName As String
        Public Property FontTag As String
        Public Property Color As Color
        Public Property Word As String
        Private _FontSizeTag As String
        Private _FontSize As Integer
        Sub New(Color As Color, Word As String, FontName As String)
            Me.Color = Color
            Me.Word = Word
            Me.FontName = FontName
            Me.FontSize = 16
        End Sub
        Public ReadOnly Property WordRTF As String
            Get
                Return Me.ColorTag & Me.Word & "\cf0 "
            End Get
        End Property
        Public ReadOnly Property FontSizeTag As String
            Get
                Return _FontSizeTag
            End Get
        End Property
        Public Property FontSize As Integer
            Get
                Return _FontSize
            End Get
            Set(value As Integer)
                _FontSizeTag = "\fs" & value.ToString
                _FontSize = value
            End Set
        End Property
        Sub New(Color As Color, Word As String)
            Me.Color = Color
            Me.Word = Word
            Me.FontName = "Consolas"
            Me.FontSize = 16
        End Sub
    End Class
    'Private Class FontTag
    '    Public FontName As String
    '    Public FontTag As String
    '    Sub New(FontName As String, FontTag As String)
    '        Me.FontName = FontName
    '        Me.FontTag = FontTag
    '    End Sub
    'End Class
    Private Class WordColorTag
        Public Color As Color
        Public ColorTag As String
        Sub New(Color As Color, Tag As String)
            Me.Color = Color
            Me.ColorTag = Tag
        End Sub
    End Class
#End Region
End Class